home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / 4cmp22s.zip / MTDEMO.4TH < prev    next >
Text File  |  1994-10-30  |  2KB  |  81 lines
  1. \ Multitasking Demonstration
  2. \ This program is Copyright (C) 1987 by Thomas Almy.  All rights reserved.
  3. NOMAP 
  4. 2000 SEPSSEG
  5. 10000 100 MSDOSEXE
  6. INCLUDE FACIL1
  7. INCLUDE MULTID
  8. DECIMAL
  9. \ display string task
  10. \ The format of a a display string message is:
  11. \  2 bytes: message handler (reserved)
  12. \  1 byte: message length
  13. \  n bytes: message body
  14.  
  15. 2 CONSTANT >MLEN    \ Offsets to length and body of messages
  16. 3 CONSTANT >MBODY
  17.  
  18. : DSPR 5 FOREGROUND
  19.      0
  20.      BEGIN 
  21.            GET-MESSAGE >R        \ if there is a message, then display it
  22.        40 4 AT-XY 40 SPACES  \ erase the old message
  23.            40 4 AT-XY
  24.            R@  >MLEN ?DS: PAD R@ >MLEN C@L CHAR+ CMOVEL
  25.            PAD COUNT TYPE
  26.            R> FREE
  27.            1+
  28.     AGAIN
  29. ;
  30.  
  31. \ counter task -- increment count on screen
  32. : CNTR  3 FOREGROUND
  33.       0   BEGIN 40 0 AT-XY  DUP 6 .R 1+ AGAIN ;
  34.  
  35. \ time and date task -- display current time and date every second
  36. 1 0 IN/OUT
  37. : 2d.  0 <# # # #> TYPE ;
  38.  
  39. : TIMR  6 FOREGROUND
  40.       BEGIN  TIME&DATE 40 2 AT-XY 
  41.              SWAP 2d. [CHAR] / EMIT
  42.              SWAP 2d. [CHAR] / EMIT
  43.              2d. 2 SPACES
  44.              2d. [CHAR] : EMIT
  45.              2d. [CHAR] : EMIT
  46.              2d. 
  47.              1000 MS    \ delay
  48.       AGAIN
  49. ;
  50.  
  51. ' CNTR TASK COUNTUP
  52. ' TIMR TASK CLOCK
  53. ' DSPR TASK DISPLAYER
  54.  
  55. 0 VALUE STRLEN
  56. : MAIN 
  57.   INIT-TASKS        \  REQUIRED!
  58.  
  59.   PAGE 0 6 AT-XY
  60.  
  61.   COUNTUP WAKE        \ wake up other tasks
  62.   CLOCK WAKE
  63.   DISPLAYER WAKE
  64.  
  65.   BEGIN
  66.      PAD 40 ACCEPT TO STRLEN CR  \ read a line and pass it as a message
  67.      STRLEN WHILE \ quit on empty line
  68.      STRLEN 18 + 4 RSHIFT GET >R \ space for message
  69.      STRLEN R@ >MLEN C!L         \ message length (2 bytes from start)
  70.      ?DS: PAD R@ >MBODY STRLEN CMOVEL \ message content (3 bytes from start)
  71.      R> DISPLAYER SEND-MESSAGE
  72.   REPEAT
  73.   BYE            \ REQUIRED! Must exit via BYE
  74. ;
  75.  
  76. INCLUDE FARMEM2
  77. INCLUDE FACIL2
  78. INCLUDE FORTHLIB
  79.  
  80. END
  81.